home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO108.dsk / EDIT.bas < prev    next >
BASIC Source File  |  2012-02-16  |  44KB  |  707 lines
  1. 0  REM PRODOS VER 3 FAMILY ROOTS: EDIT PROGRAM. COPYRIGHT (C) 1986, STEPHEN C. VORENBERG 
  2. 40  GOTO 16000
  3. 300 A$ = "": PRINT "?";: IF OP(14)  THEN  FOR I = 1 TO 256: GET E$: POKE  -16368,0:R =  ASC(E$): PRINT  CHR$(R *(R >31));: GOTO 304
  4. 302  CALL LI:T$ =  MID$ (T$,1): IF T$ = ""  THEN 402
  5. 303  FOR I = 1 TO  LEN(T$):R =  ASC( MID$ (T$,I,1))
  6. 304  IF R = 13  THEN I = 256: GOTO 401
  7. 305  IF R >64  THEN 400
  8. 310  IF R = 34  THEN R = 39: GOTO 400
  9. 320  IF R = 32  THEN 385
  10. 325  IF R >32  THEN 400
  11. 327  IF R = 8  THEN 365
  12. 330  IF R = 5  THEN A$ =  CHR$(R):I = 256: GOTO 401
  13. 335  IF R =  ASC(CZ$)  THEN CZ = 1:I = 256:A$ = "": GOTO 401
  14. 340  IF KY <0  THEN 355
  15. 345  FOR N = 0 TO KY: IF R < >KY(N)  THEN 350
  16. 346  IF OP(14)  THEN  PRINT KY$(N);
  17. 347 A$ = A$ +KY$(N):N = KY: NEXT : GOTO 401
  18. 350  NEXT 
  19. 355  IF   NOT OP(15)  OR R = 3  OR R = 4  OR R = 9  OR R = 10  OR R = 12  OR R = 19  OR R = 21  THEN 401
  20. 360  GOTO 400
  21. 365  IF A$ = ""  THEN 401
  22. 370  PRINT  CHR$(8);: IF  LEN(A$) = 1  THEN A$ = "":I = 0: GOTO 401
  23. 375 A$ =  LEFT$(A$, LEN(A$) -1):I = I -1: GOTO 401
  24. 385  IF  LEN(A$) = 0  THEN  NEXT 
  25. 390  IF  RIGHT$(A$,1) = " "  THEN  NEXT 
  26. 400 A$ = A$ + CHR$(R)
  27. 401  NEXT : IF OP(14)  THEN  PRINT 
  28. 402  RETURN 
  29. 410 W = LA: IF W = 0  OR OP(13) <0  THEN  RETURN 
  30. 420  GOSUB 2600: IF BB <1  THEN C2 = 2: RETURN 
  31. 421 BB = W: FOR I = 0 TO Q(37) -1: IF PA(I) <W  AND W < = CT(I)  THEN W = W -PA(I) +Q(36) *I:SC(I) = SC(I) +1:I = Q(37)
  32. 422  NEXT :J =  LEN(NA$(W)):K = 0:N1$ = "":N2$ = "":N3$ = "":N4$ = "": IF J = 0  THEN 470
  33. 425  FOR I =  LEN(NA$(W)) TO 1  STEP  -1: IF  MID$ (NA$(W),I,1) < >Q$(5)  THEN 460
  34. 430 K = K +1: IF I -J = 0  THEN 455
  35. 435  ON K GOTO 450,445,440
  36. 440 N1$ =  MID$ (NA$(W),I +1,J -I): GOTO 455
  37. 445 N2$ =  MID$ (NA$(W),I +1,J -I): GOTO 455
  38. 450 N4$ =  RIGHT$(NA$(W),J -I)
  39. 455 J = I -1: IF K = 3  THEN I = 1
  40. 460  NEXT : IF J -I >0  THEN N3$ =  LEFT$(NA$(W),J -I)
  41. 465  IF K = 2  THEN N1$ = N2$:N2$ = N3$:N3$ = ""
  42. 470 W = BB: RETURN 
  43. 500  IF U <1  OR U >30  THEN  PRINT "RECORD NUMBERS MUST BE BETWEEN 1 AND 30";: GOSUB 860: PRINT "ON THE TRIAL DISK.":U = 0
  44. 510  RETURN 
  45. 600  PRINT "PRESS ANY KEY WHEN READY";: GOSUB 690: RETURN 
  46. 621  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN XZ = Q(28): POKE  -16368,0
  47. 624  RETURN 
  48. 636  IF W = 0  THEN  PRINT : GOSUB 3800: RETURN 
  49. 637  GOSUB 645: IF  LEN( STR$(W)) >Q(22) -IX -4 - LEN(RN$)  THEN  PRINT : GOSUB 3800: PRINT  SPC( K);
  50. 638  PRINT " ("RN$"="W")": GOSUB 3800: RETURN 
  51. 639  GOSUB 645: PRINT : GOSUB 3800: RETURN 
  52. 645  IF C2 = 2  THEN C2 = 1: PRINT "(NAME NOT ACCESSIBLE)";:K = IX:IX = IX +21: RETURN 
  53. 646 K = IX: IF Q(22) -IX > =  LEN(N1$)  THEN 653
  54. 648 J = 0: FOR I = Q(22) -IX TO 1  STEP  -1: IF  MID$ (N1$,I,1) = " "  THEN J = I:I = 1
  55. 649  NEXT : IF J <2  THEN IX = IX -Q(22): GOSUB 3800: GOTO 653
  56. 651  PRINT  LEFT$(N1$,J -1): GOSUB 3800: PRINT  SPC( K) RIGHT$(N1$, LEN(N1$) -J);:IX = K + LEN(N1$) -J: GOTO 655
  57. 653  PRINT N1$;:IX = IX + LEN(N1$)
  58. 655  IF Q(22) -IX < =  LEN(N2$)  THEN  PRINT : GOSUB 3800: PRINT  SPC( K)N2$;:IX = K + LEN(N2$): GOTO 660
  59. 657  IF N2$ < >""  THEN  PRINT " "N2$;:IX = IX + LEN(N2$) +1
  60. 660  IF Q(22) -IX < =  LEN(N3$)  THEN  PRINT : GOSUB 3800: PRINT  SPC( K)N3$;:IX = K + LEN(N3$): GOTO 665
  61. 663  IF N3$ < >""  THEN  PRINT " "N3$;:IX = IX + LEN(N3$) +1
  62. 665  IF Q(22) -IX < =  LEN(N4$)  THEN  PRINT : GOSUB 3800: PRINT  SPC( K)N4$;:IX = K + LEN(N4$): RETURN 
  63. 670  IF N4$ < >""  THEN  PRINT " "N4$;:IX = IX + LEN(N4$) +1
  64. 672  RETURN 
  65. 690  GET YN$: POKE  -16368,0: NORMAL : PRINT YN$: IF  ASC(YN$) >95  THEN YN$ =  CHR$( ASC(YN$) -32)
  66. 691  RETURN 
  67. 740  PRINT H$(C1)" BY "H1$(2):LO = 0:B$ = "FIRST "
  68. 745  PRINT B$;: INPUT "NUMBER? ";A$: IF A$ = ""  THEN 765
  69. 746  IF A$ = CZ$  THEN LO = 0: RETURN 
  70. 747 A =  VAL(A$):U = A: GOSUB 500: IF   NOT U  THEN 745
  71. 749 LO = LO +1:SV(LO) = A:B$ = "NEXT ": IF LO <Q(24)  THEN 745
  72. 765  IF LO = 0  THEN  RETURN 
  73. 770  GOSUB 840: FOR XZ = 1 TO LO:X = SV(XZ): GOSUB 7620: GOSUB 2000: GOSUB 621: NEXT XZ: RETURN 
  74. 840  IF LO <1  THEN  PRINT : PRINT "NO LIST IN MEMORY": RETURN 
  75. 842  PRINT : PRINT "LIST=";: FOR I = 1 TO LO: PRINT SV(I);: IF I <LO  THEN  PRINT ",";
  76. 845  NEXT : PRINT : RETURN 
  77. 850  PRINT : IF Q(43) = 0  OR Q(40)  THEN  HOME : RETURN 
  78. 855  PRINT  CHR$(12): RETURN 
  79. 860  IF Q(22) <79  THEN  PRINT : RETURN 
  80. 861  PRINT " ";: RETURN 
  81. 1000  INPUT "START NUMBER? ";A$: IF A$ = ""  THEN  RETURN 
  82. 1010 X3 =  VAL(A$):U = X3: GOSUB 500: IF   NOT U  THEN 1000
  83. 1080  INPUT "END NUMBER? ";A$:X4 =  VAL(A$): IF X4 = 0  THEN X4 = X3
  84. 1090 U = X4: GOSUB 500: IF   NOT U  THEN 1080
  85. 1110  PRINT : PRINT : PRINT H1$(1)": "X3;: IF X3 <X4  THEN  PRINT " TO "X4;
  86. 1115  PRINT 
  87. 1120  FOR XZ = X3 TO X4:X = XZ
  88. 1140  GOSUB 7620
  89. 1160  GOSUB 2000
  90. 1180  GOSUB 621: NEXT : RETURN 
  91. 1260  PRINT "EDIT RECORDS HAVING ALL THE FOLLOWING";: GOSUB 860: PRINT "NAME PARTS IN COMMON:": PRINT  TAB( 5)"--LAST NAME AT BIRTH";: INPUT NL$
  92. 1280  PRINT  TAB( 5)"--FIRST NAME(S)";: INPUT NF$: PRINT  TAB( 5)"--MARRIED NAME";: INPUT NM$
  93. 1290  IF NF$ +NL$ +NM$ = ""  THEN  RETURN 
  94. 1300  PRINT : INPUT "START NUMBER?";A$:X3 =  VAL(A$): IF X3 = 0  THEN 1305
  95. 1301 U = X3: GOSUB 500: IF U  THEN 1350
  96. 1302  IF   NOT U  THEN 1300
  97. 1305  IF A$ = CZ$  THEN  RETURN 
  98. 1310 A = Q(28): FOR I = 1 TO MP: IF WH(I,0) > -1  THEN  IF A >WH(I,0)  THEN A = WH(I,0)
  99. 1315  NEXT :X3 = A +1
  100. 1350  INPUT "END NUMBER?";A$:X4 =  VAL(A$): IF X4 <X3  THEN 1355
  101. 1351 U = X4: GOSUB 500: IF U  THEN 1380
  102. 1352  IF   NOT U  THEN 1350
  103. 1355  IF A$ = CZ$  THEN  RETURN 
  104. 1360 X4 = X3 +ND -1: FOR J = 1 TO MP: FOR I = 1 TO MP: IF WH(I,0) = X4  THEN X4 = X4 +ND
  105. 1365  NEXT : NEXT 
  106. 1380  PRINT : PRINT "EDIT RECORDS FROM "X3" TO "X4" HAVING";: GOSUB 860: PRINT "THE FOLLOWING NAMES IN COMMON:": PRINT "'"NF$"' '"NL$"' '"NM$"'"
  107. 1400 LO = 0: FOR XZ = X3 TO X4:W = XZ: GOSUB 420
  108. 1405  IF NL$ = ""  THEN 1420
  109. 1410  IF NL$ < >N2$  THEN 1520
  110. 1420  IF NM$ = ""  THEN 1440
  111. 1430  IF NM$ < >N3$  THEN 1520
  112. 1440  IF NF$ = ""  THEN 1460
  113. 1450 Z = 0:AA$ = N1$:BB$ = NF$: GOSUB 7840: IF Z = 0  THEN 1520
  114. 1460  IF LO <Q(24)  THEN LO = LO +1:SV(LO) = XZ
  115. 1480 X = XZ: GOSUB 7620: GOSUB 2000
  116. 1520  GOSUB 621: NEXT XZ: RETURN 
  117. 1600  POKE 34,0: GOSUB 850: PRINT "SELECT PARAMETER BY LETTER:": PRINT 
  118. 1605  FOR I = 1 TO OP: PRINT  CHR$(64 +I)") "OP$(I) SPC( 30 - LEN(OP$(I)) - LEN( STR$(OP(I))))"[NOW ";: IF TY(I)  THEN  PRINT  CHR$(78 *(OP(I) = 0) +89 *(OP(I) >0));: GOTO 1615
  119. 1610  PRINT OP(I);
  120. 1615  PRINT "]": IF 4 * INT(I/4) = I  THEN  PRINT 
  121. 1620  NEXT :J = OP: IF Q(26)  THEN V1$ = "DATE":J = J +1: PRINT  CHR$(64 +J)") "V1$ SPC( 26 - LEN(DY$))"[NOW "DY$"]"
  122. 1625  PRINT : INVERSE : PRINT "WHICH (A-" CHR$(64 +J)")?";: GOSUB 690: IF  ASC(YN$) = 13  THEN  RETURN 
  123. 1630 A =  ASC(YN$) -64: IF A <1  OR A >J  THEN 1625
  124. 1635  PRINT : IF A <OP +1  THEN 1650
  125. 1640  PRINT V1$;: INPUT YN$: IF YN$ < >""  THEN DY$ = YN$:A$ = YN$: GOSUB 4200:DZ$ = A$
  126. 1645  GOTO 1600
  127. 1650  PRINT OP$(A);: IF TY(A)  THEN  PRINT "?";: GOSUB 690: GOTO 1660
  128. 1655  GOSUB 300:YN$ = A$
  129. 1660  IF YN$ =  CHR$(13)  OR YN$ = ""  THEN 1600
  130. 1665  IF TY(A)  THEN OP(A) = (YN$ = "Y"  OR YN$ = "T"): GOTO 1600
  131. 1670 OP(A) =  VAL(YN$): IF A = 7  THEN C4 = 1
  132. 1675  GOTO 1600
  133. 1700  IF OP(11)  THEN Y = X:W = X:IX = 0:X5 = 0: POKE 34,0: GOSUB 850: GOSUB 420: GOSUB 636: PRINT : POKE 34,X5: RETURN 
  134. 1705 Y = X:W = X:IX = 0:X5 = 0: POKE 34,0: GOSUB 850: GOSUB 420
  135. 1710  GOSUB 636: IF   NOT Q(26)  THEN 1725
  136. 1715  IF  LEN(RC$(11)) = 8  THEN X5 = X5 +1: PRINT  SPC( 3)"(LAST UPDATED " LEFT$(RC$(11),2)"/" MID$ (RC$(11),3,2)"/" RIGHT$(RC$(11),4)")": GOTO 1725
  137. 1720  IF RC$(11) < >""  THEN X5 = X5 +1: PRINT  SPC( 3)"(LAST UPDATED "RC$(11)")"
  138. 1725  PRINT :X5 = X5 +1: POKE 34,X5: FOR IP = 1 TO 4: PRINT IP") "VR$(IP)": ";:IX = 5 + LEN(VR$(IP)): IF Q(22) -IX > =  LEN(RC$(IP))  THEN  PRINT RC$(IP): GOSUB 3800: GOTO 1735
  139. 1730 A$ = RC$(IP): GOSUB 5900: PRINT : GOSUB 3800
  140. 1735  NEXT IP:X6 = 0: IF Q(44) <1  THEN 1760
  141. 1740 X6 = X6 +1: IF X6 >Q(44)  THEN 1760
  142. 1745 IP = X6 +11: IF DF(IP) = 2  THEN A$ = RC$(IP): GOSUB 5500: GOSUB 410: PRINT X6 +4") "Q$(IP)": ";:IX =  LEN( STR$(X6 +4)) + LEN(Q$(IP)) +4: GOSUB 5600: PRINT : GOSUB 3800: GOTO 1740
  143. 1750  PRINT X6 +4") "Q$(IP)": ";:IX =  LEN( STR$(X6 +4)) + LEN(Q$(IP)) +4: IF Q(22) -IX > =  LEN(RC$(IP))  THEN  PRINT RC$(IP): GOSUB 3800: GOTO 1740
  144. 1755 A$ = RC$(IP): GOSUB 5900: PRINT : GOSUB 3800: GOTO 1740
  145. 1760 X6 = 4 +Q(44)
  146. 1765 X6 = X6 +1: IF X6 >6 +Q(44)  THEN 1775
  147. 1770 IP = 12 +Q(44) -X6:A$ = RC$(IP): GOSUB 5500: GOSUB 410: PRINT X6") "VR$(IP)": ";:IX =  LEN( STR$(X6)) + LEN(VR$(IP)) +4: GOSUB 5600: PRINT : GOSUB 3800: GOTO 1765
  148. 1775 IQ = 7 +Q(44):IP = 7
  149. 1780 IP = IP +1: IF IP >10  THEN  RETURN 
  150. 1785  PRINT IQ") "VR$(IP)": "RC$(IP): GOSUB 3800:A$ = RC$(IP): GOSUB 5500: IF LA = 0  THEN 1845
  151. 1790 L = 0: ON IP -7 GOTO 1795,1820,1830
  152. 1795 L = L +1: IF L >MG  THEN 1845
  153. 1800 A$ = MI$(1,L): GOSUB 5500: GOSUB 410: PRINT IQ +1;") "WR$(1);L": ";:IX =  LEN( STR$(IQ +1)) + LEN(WR$(1)) +5: GOSUB 5600: PRINT : GOSUB 3800
  154. 1805  FOR X1 = 2 TO 4: PRINT IQ +X1;") "WR$(X1)": ";:IX =  LEN( STR$(IQ +X1)) + LEN(WR$(X1)) +4: IF  LEN(MI$(X1,L)) < = Q(22) -IX  THEN  PRINT MI$(X1,L): GOTO 1815
  155. 1810 A$ = MI$(X1,L): GOSUB 5900: PRINT 
  156. 1815  GOSUB 3800: NEXT X1:IQ = IQ +4: GOTO 1795
  157. 1820 L = L +1: IF L >CN  THEN IQ = IQ +CN: GOTO 1845
  158. 1825 A$ = C$(L): GOSUB 5500: GOSUB 410: PRINT L +IQ;") CHILD "L": ";:IX =  LEN( STR$(L +IQ)) + LEN( STR$(L)) +10: GOSUB 5600: PRINT : GOSUB 3800: GOTO 1820
  159. 1830  FOR L = 1 TO NT: PRINT IQ +L") NOTE "L": ";:IX =  LEN( STR$(IQ +L)) + LEN( STR$(L)) +9: IF  LEN(EX$(L)) < = Q(22) -IX  THEN  PRINT EX$(L): GOTO 1840
  160. 1835 A$ = EX$(L): GOSUB 5900: PRINT 
  161. 1840  GOSUB 3800: NEXT L:IQ = IQ +NT
  162. 1845 IQ = IQ +1: GOTO 1780
  163. 2000 C2 = 1: GOSUB 1700
  164. 2005 OB = 0:OD = 0:OG = 0: FOR I = 0 TO Q(19): FOR J = 0 TO 4:S$(J,I) = "": NEXT : NEXT : FOR I = 1 TO Q(18):OE(I) = 0:EM$(I) = "": NEXT : GOSUB 621
  165. 2010  PRINT : INVERSE : PRINT "MAKE ANY CHANGES HERE (Y/N/S/P/D/K)?";: GOSUB 690
  166. 2015  IF YN$ = CZ$  THEN XZ = Q(28): GOTO 2095
  167. 2020  IF YN$ = "P"  THEN  GOSUB 1600: GOTO 2000
  168. 2025  IF YN$ = "K"  THEN  GOSUB 8600: GOTO 2000
  169. 2030  IF YN$ = "N"  THEN 2095
  170. 2035  IF YN$ = "Y"  THEN RC$(11) = DZ$: GOSUB 2135: GOTO 2055
  171. 2040  IF YN$ = "S"  THEN RC$(11) = DZ$: GOSUB 2280: GOSUB 1700: GOSUB 2135: GOTO 2055
  172. 2045  IF YN$ = "D"  OR YN$ = "V"  THEN  GOSUB 1705: GOTO 2005
  173. 2050  GOTO 2010
  174. 2055 C2 = 0: IF CZ = 1  THEN  POKE 34,0: GOSUB 850: FOR I = 1 TO 8: PRINT : NEXT : PRINT "NOTHING SAVED FOR "RN$"="X: FOR I = 1 TO 2000: NEXT : RETURN 
  175. 2060  GOSUB 8100: IF JR  THEN C2 = 1: GOSUB 1700: GOTO 2010
  176. 2065  IF   NOT OP(2)  THEN 2095
  177. 2070  GOSUB 7100: PRINT "COMPLEMENTING":Y = X: GOSUB 3400: IF OP(4)  AND OD >0  THEN  GOSUB 5000
  178. 2075  IF OB >0  THEN  GOSUB 6880
  179. 2080  IF OD >0  THEN  GOSUB 7400
  180. 2085  IF OG >0  THEN  GOSUB 7220
  181. 2090  IF S$(0,0) < >""  THEN  GOSUB 4800
  182. 2095 C2 = 0: POKE 34,0: RETURN 
  183. 2130  GET CH$: PRINT CH$;: POKE  -16368,0: IF  ASC(CH$) >96  AND  ASC(CH$) <123  THEN CH$ =  CHR$( ASC(CH$) -32)
  184. 2134  RETURN 
  185. 2135 CZ = 0: PRINT "CHANGE WHICH ITEM (0-"9 +Q(44) +4 *MG +CN +NT"/S/P/D/K)?";
  186. 2138  GOSUB 2130: IF CH$ =  CHR$(13)  THEN  RETURN 
  187. 2139  IF CH$ = CZ$  THEN CZ = 1: RETURN 
  188. 2140  IF  ASC(CH$) >95  THEN CH$ =  CHR$( ASC(CH$) -32)
  189. 2141  IF CH$ = "K"  THEN  GOSUB 8600: GOSUB 1700: GOTO 2135
  190. 2142  IF CH$ = "P"  THEN  GOSUB 1600:RC$(11 *(Q(26) >0)) = DZ$: GOSUB 1700: GOTO 2135
  191. 2143  IF CH$ = "S"  THEN  PRINT : GOSUB 2280: GOSUB 1700: GOTO 2135
  192. 2144  IF CH$ = "D"  OR CH$ = "V"  THEN  GOSUB 1705: GOTO 2135
  193. 2145  IF  LEFT$(CH$,1) <"0"  OR  LEFT$(CH$,1) >"9"  THEN  PRINT : GOTO 2135
  194. 2146  GET YN$: POKE  -16368,0: PRINT YN$;: IF YN$ > = "0"  AND YN$ < = "9"  THEN CH$ = CH$ +YN$: GOTO 2146
  195. 2147  IF YN$ =  CHR$(13)  THEN 2154
  196. 2148  IF YN$ < > CHR$(8)  THEN 2146
  197. 2149  IF  LEN(CH$) >1  THEN CH$ =  LEFT$(CH$, LEN(CH$) -1): GOTO 2146
  198. 2150 CH$ = "": GOTO 2138
  199. 2154  IF CH$ = ""  THEN  RETURN 
  200. 2155 CH =  VAL(CH$): IF CH <0  OR CH >9 +Q(44) +4 *MG +CN +NT  THEN 2135
  201. 2156 FC = 0: GOSUB 2160: IF FC  AND CH >0  AND   NOT OP(11)  THEN  GOSUB 1705
  202. 2157  IF FC  AND CH = 0  THEN  GOSUB 1700
  203. 2158  GOTO 2135
  204. 2160  IF OP(13) <1  THEN OP(13) =  -1
  205. 2162  IF CH = 0  THEN W = Y: POKE 34,0: GOSUB 420:X = Y: GOSUB 10070:FC = 1: GOSUB 850: GOTO 2247
  206. 2165  IF CH <5  THEN  GOSUB 2340: GOTO 2240
  207. 2167  IF CH >4  AND CH < = 4 +Q(44)  THEN  GOSUB 3600: GOTO 2240
  208. 2170  IF CH = 5 +Q(44)  OR CH = 6 +Q(44)  THEN  GOSUB 3080: GOTO 2240
  209. 2180  IF CH = 7 +Q(44)  THEN IP = 8: GOSUB 2820: GOTO 2240
  210. 2190  IF CH < = 4 *MG +7 +Q(44)  THEN  GOSUB 2420: GOTO 2240
  211. 2200  IF CH = 4 *MG +8 +Q(44)  THEN IP = 9: GOSUB 2820: GOTO 2240
  212. 2210  IF CH < = CN +4 *MG +8 +Q(44)  THEN  GOSUB 3160: GOTO 2240
  213. 2220  IF CH = 4 *MG +CN +9 +Q(44)  THEN IP = 10: GOSUB 2820: GOTO 2240
  214. 2230  IF CH < = NT +CN +4 *MG +9 +Q(44)  THEN  GOSUB 2860
  215. 2240  GOSUB 8440: IF A >Q(16)  THEN  INVERSE : PRINT "THAT ENTRY MAKES THE RECORD EXCEED ITS";: GOSUB 860: PRINT "LENGTH BY "A -Q(16)" CHARACTERS. SHORTEN SOME": PRINT "FIELDS.": NORMAL 
  216. 2245  IF OP(1)  THEN  PRINT  TAB( 8)"("A" OF "Q(16)" CHAR. USED IN RECORD)"
  217. 2247  IF OP(13) <0  THEN OP(13) = 0
  218. 2250  RETURN 
  219. 2280 CH = OP(8) -1:CZ = 0: IF CH < -1  THEN  RETURN 
  220. 2285 CH = CH +1: IF CH >9 +4 *MG +CN +NT +Q(44)  THEN  RETURN 
  221. 2290  GOSUB 2160: IF CZ  THEN  RETURN 
  222. 2295  GOTO 2285
  223. 2340  PRINT CH") "VR$(CH);:A$ = RC$(CH):IX = 3 + LEN(VR$(CH)):X7 = 0: GOSUB 2700: GOSUB 300: IF A$ = ""  OR CZ  THEN  RETURN 
  224. 2341  IF A$ =  CHR$(5)  THEN A$ = "": GOTO 2360
  225. 2342  IF CH < >3  THEN 2350
  226. 2343 B$ = "": FOR I = 1 TO  LEN(A$):D$ =  MID$ (A$,I,1): IF  ASC(D$) >95  THEN D$ =  CHR$( ASC(D$) -32)
  227. 2344 B$ = B$ +D$: NEXT : IF  LEFT$(B$,1) < >"L"  THEN 2350
  228. 2346  IF  LEFT$("LIVING", LEN(B$)) = B$  THEN RC$(CH) = "L": RETURN 
  229. 2347 LB = 0: FOR I =  LEN(A$) TO 1  STEP  -1: IF  MID$ (A$,I,1) = Q$(4)  THEN LB = I:I = 1
  230. 2348  NEXT : IF LB >1  THEN RC$(CH) = "L" + RIGHT$(A$, LEN(A$) -LB +1): RETURN 
  231. 2350  IF CH = 1  OR CH = 3  THEN  GOSUB 4200
  232. 2355  IF CH = 4  AND OP(5)  THEN  IF  LEFT$(RC$(3),1) = "L"  THEN S$(0,0) = A$
  233. 2360 RC$(CH) = A$: RETURN 
  234. 2420 IP = CH -4 * INT((CH -1)/4) +9 -Q(44):IP = IP -4 * INT((IP -1)/4):IQ =  INT((CH -4 -Q(44))/4): IF IP >1  THEN 2440
  235. 2430 X7 = 1:A$ = MI$(1,IQ): GOSUB 5500: GOSUB 410: PRINT CH") "WR$(1)IQ;:IX = 4 + LEN(WR$(1)): GOSUB 2700: GOSUB 3300: IF A$ = ""  OR CZ  THEN  RETURN 
  236. 2432  IF A$ =  CHR$(5)  THEN A$ = ""
  237. 2435 MI$(1,IQ) = A$: GOSUB 3040: RETURN 
  238. 2440  PRINT CH") "WR$(IP)" (MRG.#"IQ")";:IX = 14 + LEN(WR$(IP)):X7 = 0:A$ = MI$(IP,IQ): GOSUB 2700: GOSUB 300: IF A$ = ""  OR CZ  THEN  RETURN 
  239. 2445  IF A$ =  CHR$(5)  THEN A$ = ""
  240. 2447 MI$(IP,IQ) = A$: IF IP = 2  THEN  GOSUB 4200:MI$(IP,IQ) = A$
  241. 2450  IF IP <4  OR A$ = ""  THEN 2460
  242. 2451 B$ =  LEFT$(A$,1): IF  ASC(B$) >95  THEN B$ =  CHR$( ASC(B$) -32)
  243. 2452  IF B$ = "M"  OR B$ = "D"  OR B$ = "E"  OR B$ = "W"  THEN MI$(IP,IQ) = B$
  244. 2454 LB = 0: FOR I =  LEN(A$) TO 1  STEP  -1: IF  MID$ (A$,I,1) = Q$(4)  THEN LB = I:I = 1
  245. 2456  NEXT : IF LB >0  THEN MI$(IP,IQ) = B$ + RIGHT$(A$, LEN(A$) -LB +1)
  246. 2460  IF A$ < >""  THEN  GOSUB 3000
  247. 2470  RETURN 
  248. 2500 BB = 2: RETURN 
  249. 2600 AA =  -1: FOR I = 0 TO Q(37) -1: IF PA(I) <W  AND W < = CT(I)  THEN AA = I:I = Q(37)
  250. 2610  NEXT :BB = Q(28): IF AA > -1  THEN  RETURN 
  251. 2620  FOR I = 0 TO Q(37) -1: IF BB >SC(I)  THEN BB = SC(I):AA = I
  252. 2630  NEXT : GOSUB 10470: IF X1  THEN BB = 0: RETURN 
  253. 2640  GOSUB 2500: IF C2 = 2  THEN  RETURN 
  254. 2645  IF FS < >BB  THEN  GOSUB 8650
  255. 2650  ONERR  GOTO 16720
  256. 2660  IF FS = 0  THEN  GOSUB 2896:ZN$ = PF$ +"NAMELIST." + STR$(WH(BB,4)): PRINT  CHR$(4)"OPEN"ZN$",S"WH(BB,2)",D"WH(BB,3)",L"Q(36) *Q(14) +Q(38):FS = BB
  257. 2662 R =  INT((W -WH(BB,0) -1)/Q(36)) +1: PRINT  CHR$(4)"READ"ZN$",R"R
  258. 2665 PA(AA) = Q(36) *(R -1): INPUT R: INPUT R:II = 1:I = Q(36) *AA +1: CALL LI:NA$(I) =  MID$ (T$,1): IF NA$(I) < >""  THEN  IF  ASC(NA$(I)) = 34  THEN II = 2:NA$(I) =  MID$ (NA$(I),2)
  259. 2670  FOR I = I +1 TO Q(36) *(AA +1): CALL LI:NA$(I) =  MID$ (T$,II): NEXT : PRINT  CHR$(4):SC(AA) = 0:PA(AA) = PA(AA) +WH(BB,0):CT(AA) = PA(AA) +Q(36): POKE 216,0: RETURN 
  260. 2700  IF OP(13) <1  THEN  RETURN 
  261. 2705 X5 = 0: PRINT " [NOW ";: IF A$ = ""  THEN A$ = "-EMPTY-"
  262. 2707  IF IX +7 >Q(22)  THEN  GOSUB 3800
  263. 2710 IX = IX +7: IF IX + LEN(A$) +2 >Q(22)  OR (X7 >0  AND LA >0)  THEN  PRINT : PRINT  SPC( 4);:IX = 8
  264. 2712  PRINT  CHR$(34);: IF X7  THEN  GOSUB 5600: PRINT  CHR$(34);: GOTO 2720
  265. 2715  GOSUB 5900: PRINT  CHR$(34);
  266. 2720  PRINT "]";: RETURN 
  267. 2820  PRINT CH") "VR$(IP);:A$ = RC$(IP):IX = 4 + LEN(VR$(IP)):X7 = 0: GOSUB 2700: GOSUB 300: IF A$ = ""  OR CZ  THEN  RETURN 
  268. 2825  IF A$ =  CHR$(5)  THEN A$ = ""
  269. 2832  GOSUB 5700: ON IP -7 GOTO 2834,2836,2838
  270. 2834  IF A >Q(19)  THEN 2820
  271. 2835 MG = A: GOTO 2840
  272. 2836  IF A >Q(18)  THEN 2820
  273. 2837 CN = A: GOTO 2840
  274. 2838  IF A >Q(17)  THEN 2820
  275. 2839 NT = A
  276. 2840 FC = 1:RC$(IP) = A$: RETURN 
  277. 2860 IP = CH -CN -4 *MG -9 -Q(44): PRINT CH") NOTE "IP;:A$ = EX$(IP):IX = 8 + LEN( STR$(CH)) + LEN( STR$(IP)):X7 = 0: GOSUB 2700: GOSUB 300: IF A$ = ""  OR CZ  THEN  RETURN 
  278. 2865  IF A$ =  CHR$(5)  THEN A$ = ""
  279. 2870 EX$(IP) = A$: IF  LEN(A$) >Q(27)  THEN  PRINT "THAT NOTE IS A BIT LONG. REENTER? ";: GOSUB 690: IF YN$ = "Y"  THEN 2860
  280. 2880  RETURN 
  281. 2896  IF PF$ < >WH$(BB)  THEN PF$ = WH$(BB): PRINT  CHR$(4)"PREFIX"PF$",S"WH(BB,2)",D"WH(BB,3)
  282. 2897  RETURN 
  283. 2900 OG = 1: IF MI$(1,IQ) < >""  THEN LA = 1: GOSUB 3060
  284. 2915  IF MI$(4,IQ) = ""  AND OP(2)  THEN MI$(4,IQ) = "M"
  285. 2920  RETURN 
  286. 3000  GOSUB 2900: IF MI$(IP,IQ) < >""  THEN LA = IP: GOSUB 3060
  287. 3030  RETURN 
  288. 3040  IF A = 0  OR   NOT OP(2)  THEN  RETURN 
  289. 3045 W = A: GOSUB 420: PRINT "WHICH MARRIAGE IS THIS FOR"
  290. 3047 IX = 0: GOSUB 645: INPUT "?";YN$: IF YN$ = ""  THEN  RETURN 
  291. 3050  IF  VAL(YN$) <1  OR  VAL(YN$) >Q(19)  THEN 3045
  292. 3055  GOSUB 2900:S$(0,IQ) = YN$: RETURN 
  293. 3060 LB = 0: FOR I =  LEN(MI$(LA,IQ)) TO 1  STEP  -1: IF  MID$ (MI$(LA,IQ),I,1) = Q$(4)  THEN LB = I:I = 1
  294. 3065  NEXT : IF LB >1  THEN S$(LA,IQ) =  LEFT$(MI$(LA,IQ),LB -1)
  295. 3070  IF LB = 0  THEN S$(LA,IQ) = MI$(LA,IQ)
  296. 3075  RETURN 
  297. 3080 IX = 4 + LEN(VR$(X6)):X6 = 12 -CH +Q(44):X7 = 1:A$ = RC$(X6): GOSUB 5500: GOSUB 410: PRINT CH") "VR$(X6);: GOSUB 2700: GOSUB 3300: IF A$ = ""  OR CZ  THEN  RETURN 
  298. 3087  IF A$ =  CHR$(5)  THEN A$ = ""
  299. 3090 RC$(X6) = A$: IF A >0  THEN OB = OB +1:T(OB) = A
  300. 3100  RETURN 
  301. 3160 IP = CH -4 *MG -8 -Q(44):X7 = 1:A$ = C$(IP): GOSUB 5500: GOSUB 410: PRINT CH") CHILD #"IP;:IX = 10 + LEN( STR$(CH)) + LEN( STR$(IP)): GOSUB 2700: GOSUB 3300: IF A$ = ""  OR CZ  THEN  RETURN 
  302. 3170  IF A$ =  CHR$(5)  THEN A$ = ""
  303. 3175 C$(IP) = A$: IF OD > = Q(18)  THEN 3200
  304. 3180  IF   NOT OP(10)  THEN  IF A >0  THEN OD = OD +1:OD(OD) = A
  305. 3190  IF OP(10)  THEN  IF A$ < >""  THEN OD = OD +1:OD(OD) = A: GOSUB 5700:EM$(OD) = A$
  306. 3200  RETURN 
  307. 3300 A = 0: GOSUB 300: IF A$ = ""  OR A$ = " "  OR A$ =  CHR$(5)  OR CZ  THEN  RETURN 
  308. 3305  GOSUB 5500: IF LC  OR LB = 1  THEN  RETURN 
  309. 3310 U = LA: GOSUB 500: IF   NOT U  THEN CZ = 1: RETURN 
  310. 3360 A = LA: RETURN 
  311. 3400  IF OD = 0  THEN 3500
  312. 3405  IF CN = 0  THEN OD = 0: GOTO 3500
  313. 3410  FOR X3 = 1 TO OD:X6 = 1: FOR X8 = 1 TO CN:A$ = C$(X8): GOSUB 5700: IF   NOT OP(10)  THEN  IF A >0  THEN  IF A = OD(X3)  THEN X8 = CN:X6 = 0
  314. 3415  IF OP(10)  THEN  IF A$ < >""  THEN  IF A$ = EM$(X3)  THEN X8 = CN:X6 = 0
  315. 3420  NEXT : IF X6  THEN OD(X3) = 0:EM$(X3) = ""
  316. 3430  NEXT 
  317. 3500  IF OB = 0  THEN  RETURN 
  318. 3510  FOR X3 = 1 TO OB:X6 = 1: FOR X8 = 6 TO 7:A$ = RC$(X8): GOSUB 5700: IF A = T(X3)  THEN X6 = 0
  319. 3520  NEXT : IF X6  THEN T(X3) = 0
  320. 3530  NEXT : RETURN 
  321. 3600 IP = CH +7:X7 = 0:A$ = RC$(IP): IF DF(IP) = 2  THEN  GOSUB 5500: GOSUB 410:X7 = 1
  322. 3610  PRINT CH") "Q$(IP);:IX = 3 + LEN(Q$(IP)): GOSUB 2700: IF DF(IP) = 2  THEN  GOSUB 3300: GOTO 3630
  323. 3620  GOSUB 300
  324. 3630  IF A$ = ""  OR CZ  THEN  RETURN 
  325. 3640  IF A$ =  CHR$(5)  THEN A$ = ""
  326. 3650  IF DF(IP) = 1  THEN  GOSUB 4200
  327. 3655  IF G(9) < >IP  OR A$ = ""  THEN 3670
  328. 3660  GOSUB 5700:E$ =  LEFT$(A$,1): IF  ASC(E$) >96  AND  ASC(E$) <123  THEN E$ =  CHR$( ASC(E$) -32)
  329. 3662  IF LB >1  THEN A$ = E$ + RIGHT$(A$, LEN(A$) -LB +1): GOTO 3670
  330. 3665 A$ = E$
  331. 3670 RC$(IP) = A$: RETURN 
  332. 3800 R = Q(2) -3:X5 = X5 +1: IF  INT(X5/R) *R < >X5  THEN  RETURN 
  333. 3810  PRINT "PRESS ANY KEY TO CONTINUE";: GOSUB 690: IF YN$ = CZ$  THEN XZ = Q(28)
  334. 3815  IF Q(43)  AND   NOT Q(41)  THEN  RETURN 
  335. 3820 A = (YN$ < > CHR$(13)  AND (X5 >R +1  OR Q(41) >1)): VTAB R +1 +A: FOR I = 1 TO 26: PRINT " ";: NEXT : HTAB 1: VTAB R +A: PRINT : RETURN 
  336. 4200 LT$ = "": IF  LEN(A$) <4  THEN 4215
  337. 4202 Z =  LEN(A$):Z1 = 0: FOR I = Z TO 1  STEP  -1: IF  MID$ (A$,I,1) = Q$(4)  THEN Z1 = I:I = 1
  338. 4205  NEXT : IF Z1 >1  THEN LT$ =  RIGHT$(A$,Z -Z1 +1):A$ =  LEFT$(A$,Z1 -1)
  339. 4210  IF Z1 = 1  THEN LT$ = A$:A$ = ""
  340. 4215 Z1 = 0:Z2 = 0:BB$ = " "
  341. 4216 AA$ = A$:Z = 0: GOSUB 7840: IF Z = 0  THEN 4250
  342. 4218  IF Z +1 > LEN(A$)  OR Z = 1  THEN 4250
  343. 4220 Z1 = Z:AA$ =  RIGHT$(A$, LEN(A$) -Z):Z = 0: GOSUB 7840: IF Z = 0  THEN 4250
  344. 4230  IF Z +1 > LEN(A$)  THEN 4250
  345. 4240 Z2 = Z +Z1: IF  LEN(A$) = Z2  THEN 4410
  346. 4245 AA$ =  RIGHT$(A$, LEN(A$) -Z2):Z = 0: GOSUB 7840: IF Z < >0  THEN 4410
  347. 4250  IF Z1 >0  AND Z2 >0  THEN 4300
  348. 4260  IF BB$ = " "  THEN BB$ = "/": GOTO 4216
  349. 4265  IF BB$ = "/"  THEN BB$ = "-": GOTO 4216
  350. 4270  GOTO 4410
  351. 4300  IF Z1 = Z2 -1  THEN 4410
  352. 4310 FL = 1:V1$ =  LEFT$(A$,Z1 -1):V2$ =  MID$ (A$,Z1 +1,Z2 -Z1 -1):V3$ =  RIGHT$(A$, LEN(A$) -Z2): IF BB$ < >"/"  AND BB$ < >"-"  THEN 4320
  353. 4315  IF Q(25)  THEN YN$ = V1$:V1$ = V2$:V2$ = YN$
  354. 4317  GOSUB 4500: GOTO 4400
  355. 4320 AA$ =  LEFT$(V1$,1): IF (AA$ > = "A"  AND AA$ < = "Z")  OR (AA$ > = "a"  AND AA$ < = "z")  THEN  GOSUB 4700: GOTO 4400
  356. 4330  GOSUB 4600
  357. 4400  IF   NOT FL  THEN 4410
  358. 4402  IF V1$ < >"??"  THEN  IF  VAL(V1$) <1  OR  VAL(V1$) >12  THEN  PRINT "THE MONTH IS OUT OF VALID RANGE."
  359. 4403  IF V2$ < >"??"  THEN  IF  VAL(V2$) <1  OR  VAL(V2$) >31  THEN  PRINT "THE DAY IS OUT OF VALID RANGE."
  360. 4405  IF Q(25)  THEN YN$ = V1$:V1$ = V2$:V2$ = YN$
  361. 4409 A$ = V1$ +V2$ +V3$
  362. 4410 A$ = A$ +LT$: RETURN 
  363. 4500  IF  LEN(V1$) >2  OR  LEN(V2$) >2  OR  LEN(V1$) >4  THEN FL = 0: RETURN 
  364. 4510  IF  LEN(V1$) = 2  THEN 4525
  365. 4515  IF  VAL(V1$) = 0  THEN V1$ = "??": GOTO 4525
  366. 4520  IF  VAL(V1$) <10  THEN V1$ = "0" +V1$
  367. 4525  GOSUB 4530: RETURN 
  368. 4530  IF  LEN(V2$) = 2  THEN 4550
  369. 4535  IF  VAL(V2$) = 0  THEN V2$ = "??": GOTO 4550
  370. 4540  IF  VAL(V2$) <10  THEN V2$ = "0" +V2$
  371. 4550  IF  LEN(V3$) = 4  THEN  RETURN 
  372. 4560  IF  LEN(V3$) = 2  AND  VAL(V3$) >0  THEN V3$ =  LEFT$(Q$(6),2) +V3$: RETURN 
  373. 4570  FOR I = 1 TO 4 - LEN(V3$):V3$ = "?" +V3$: NEXT : RETURN 
  374. 4600  IF  LEN(V1$) >2  OR  LEN(V3$) >4  THEN FL = 0: RETURN 
  375. 4610 YN$ = V1$:V1$ = V2$:V2$ = YN$: GOSUB 4700: RETURN 
  376. 4700  IF ( LEN(V2$) >2  AND ( LEN(V2$) >3  OR  RIGHT$(V2$,1) < >","))  OR  LEN(V3$) >4  OR  LEN(V3$) <2  THEN FL = 0: RETURN 
  377. 4702 I =  ASC(V3$): IF I <48  OR I >57  THEN  IF I < >63  THEN FL = 0: RETURN 
  378. 4705  IF  RIGHT$(V2$,1) = ","  THEN V2$ =  LEFT$(V2$,2)
  379. 4710 J = 3: IF  LEN(V1$) <3  THEN J =  LEN(V1$)
  380. 4715 A$ = "": FOR I = 1 TO J:B$ =  MID$ (V1$,I,1): IF  ASC(B$) >95  AND I = 1  THEN B$ =  CHR$( ASC(B$) -32)
  381. 4717  IF I >1  AND  ASC(B$) <96  THEN B$ =  CHR$( ASC(B$) +32)
  382. 4720 A$ = A$ +B$: NEXT :L = 0: FOR I = 1 TO 12: IF  LEFT$(A$,J) =  LEFT$(MT$(I),J)  THEN L = I:I = 12
  383. 4730  NEXT : IF L = 0  THEN V1$ = "??"
  384. 4740  IF L >0  THEN V1$ =  STR$(L): IF L <10  THEN V1$ = "0" +V1$
  385. 4750  GOSUB 4530: RETURN 
  386. 4800 X = Y: GOSUB 7620:S$(0,1) =  STR$(MG):S$(1,0) =  STR$(CN): FOR I = 1 TO MG:S$(0,I +1) = MI$(1,I): NEXT : FOR I = 1 TO CN:S$(I +1,0) = C$(I): NEXT :X3 = 0
  387. 4810 X3 = X3 +1: IF X3 > VAL(S$(0,1))  THEN 4850
  388. 4815 A$ = S$(0,X3 +1): GOSUB 5500: IF   NOT LA  OR LC  THEN 4810
  389. 4820  GOSUB 4950: IF YN$ = CZ$  THEN  RETURN 
  390. 4830  GOTO 4810
  391. 4850 X4 = 0
  392. 4860 X4 = X4 +1: IF X4 > VAL(S$(1,0))  THEN  RETURN 
  393. 4865 A$ = S$(X4 +1,0): GOSUB 5500: IF   NOT LA  OR LC  THEN 4860
  394. 4870  GOSUB 4950: IF YN$ = CZ$  THEN  RETURN 
  395. 4900  GOTO 4860
  396. 4950 W = LA: IF W = 0  THEN  RETURN 
  397. 4955  GOSUB 850: PRINT : GOSUB 420:X5 = 0:IX = 3: PRINT "IS ";: GOSUB 636: PRINT "LIVING AT ";:IX = 10:A$ = S$(0,0): GOSUB 5900: PRINT : PRINT "(Y/N)?";: GOSUB 690
  398. 4960  IF YN$ < >"Y"  THEN  RETURN 
  399. 4962 X = W: GOSUB 7620: IF OP(3)  THEN RC$(4) = S$(0,0):RC$(3) = "L": GOTO 4970
  400. 4964  IF RC$(4) = ""  THEN RC$(4) = S$(0,0)
  401. 4966  IF RC$(3) = ""  OR  LEFT$(RC$(3),1) < >"L"  THEN RC$(3) = "L"
  402. 4970 X3 = Q(19): GOSUB 8100: RETURN 
  403. 5000 X9 = 1: IF CN = 0  OR MG = 0  THEN 5018
  404. 5010  IF MG = 1  THEN Z2 = 1: GOSUB 5020: RETURN 
  405. 5014 W = Y: GOSUB 420
  406. 5015  IF N3$ < >""  THEN  GOSUB 5400: RETURN 
  407. 5016 X7 = 0: FOR X3 = 1 TO MG:A$ = MI$(1,X3): GOSUB 5500: IF LA >0  AND   NOT LC  THEN X7 = X7 +1:Z2 = X3
  408. 5017  NEXT : IF X7 = 1  THEN  GOSUB 5020
  409. 5018  RETURN 
  410. 5020 A$ = MI$(1,Z2): GOSUB 5500:X = LA: IF X = 0  OR LC  THEN  RETURN 
  411. 5040  GOSUB 7620:X3 = 0
  412. 5050 X3 = X3 +1: IF X3 >OD  THEN  GOSUB 8100: RETURN 
  413. 5060 W = OD(X3):D$ = EM$(X3): IF W >0  THEN  GOSUB 420
  414. 5070  GOSUB 5200: IF FL  THEN OE(X3) = X
  415. 5150  GOTO 5050
  416. 5200 FL = 1: IF CN = 0  THEN 5260
  417. 5202  FOR X4 = 1 TO CN:A$ = C$(X4): GOSUB 5500: IF   NOT LC  THEN 5210
  418. 5203  IF OP(10)  AND X9  AND W = 0  THEN 5206
  419. 5204  IF  LEN(A$) >3  AND  LEN(N1$) >3  THEN  IF  LEFT$(A$, LEN(N1$)) = N1$  THEN X6 = X4: GOTO 5270
  420. 5205  GOTO 5210
  421. 5206  IF  LEN(A$) >3  AND  LEN(D$) >3  THEN  GOSUB 6000: IF A >.95  THEN X6 = X4: GOTO 5265
  422. 5210  NEXT : IF CN = Q(18)  THEN FL = 0: RETURN 
  423. 5220  FOR X4 = 1 TO CN:A$ = C$(X4): GOSUB 5700: IF OP(10)  AND X9  THEN  IF W = 0  THEN 5240
  424. 5230  IF A = W  AND W >0  THEN FL = 0: RETURN 
  425. 5240  NEXT :X6 = 0: FOR X4 = 1 TO CN: IF C$(X4) = ""  THEN X6 = X4:X4 = CN
  426. 5250  NEXT : IF X6 >0  THEN 5270
  427. 5260 CN = CN +1:LA = 9: GOSUB 5800:X6 = CN
  428. 5265  IF OP(10)  AND X9  THEN C$(X6) = D$: RETURN 
  429. 5270 C$(X6) =  STR$(W): RETURN 
  430. 5400 Z1 = MG:X3 = 0
  431. 5402 X3 = X3 +1: IF X3 >Z1  THEN  RETURN 
  432. 5405  IF X3 >1  THEN X = Y: GOSUB 7620
  433. 5410 A$ = MI$(1,X3): GOSUB 5500:X = LA: IF X = 0  OR LC  THEN 5480
  434. 5420  GOSUB 7620:C = CN:W = X: GOSUB 420
  435. 5425 BB$ = N2$: FOR Z2 = 1 TO OD:W = OD(Z2):D$ = EM$(Z2): IF W = 0  THEN 5435
  436. 5430  GOSUB 420: IF BB$ < >N2$  THEN 5450
  437. 5432  GOTO 5440
  438. 5435 AA$ = D$: GOSUB 7840: IF Z = 0  THEN 5450
  439. 5440  GOSUB 5200: IF FL  THEN OE(Z2) = X
  440. 5450  NEXT Z2: IF CN >C  THEN  GOSUB 8100
  441. 5480  GOTO 5402
  442. 5500 LC = 0:LB = 0:LA = 0: IF A$ = ""  THEN  RETURN 
  443. 5505  FOR I =  LEN(A$) TO 1  STEP  -1: IF  MID$ (A$,I,1) = Q$(4)  THEN LB = I:I = 1
  444. 5507  NEXT :J =  LEN(A$): IF LB >0  THEN J = LB -1
  445. 5508  IF J <1  THEN LC = 1: GOTO 5570
  446. 5510  FOR I = 1 TO J: IF  MID$ (A$,I,1) < >" "  THEN  IF  MID$ (A$,I,1) >"9"  OR  MID$ (A$,I,1) <"0"  THEN LC = 1:I = J
  447. 5550  NEXT I: IF LB >1  THEN LA =  VAL( LEFT$(A$,LB -1))
  448. 5560  IF LB = 0  THEN LA =  VAL(A$)
  449. 5570  RETURN 
  450. 5600  IF   NOT LC  THEN 5610
  451. 5604  GOSUB 5900: IF Q(22) -IX < = 6 + LEN(RN$)  THEN  PRINT : GOSUB 3800: PRINT  SPC( K);
  452. 5606  PRINT " (NO "RN$")";: RETURN 
  453. 5610  IF LA = 0  THEN  RETURN 
  454. 5612  GOSUB 645: IF LB =  LEN(A$)  OR LB = 0  THEN 5617
  455. 5614  IF  LEN(A$) -LB +1 >Q(22) -IX  THEN  PRINT : GOSUB 3800: PRINT  SPC( K);:IX = K
  456. 5615  PRINT  RIGHT$(A$, LEN(A$) -LB +1);:IX = IX + LEN(A$) -LB +1
  457. 5617  IF W = 0  THEN  RETURN 
  458. 5618  IF  LEN( STR$(W)) >Q(22) -4 - LEN(RN$) -IX  THEN  PRINT : GOSUB 3800: PRINT  SPC( K);
  459. 5620  PRINT " ("RN$"="W")";: RETURN 
  460. 5700 A = 0: IF A$ = ""  THEN 5750
  461. 5710 LB = 0: FOR I =  LEN(A$) TO 1  STEP  -1: IF  MID$ (A$,I,1) = Q$(4)  THEN LB = I:I = 1
  462. 5720  NEXT : IF LB = 0  THEN A =  VAL(A$)
  463. 5730  IF LB >1  THEN A =  VAL( LEFT$(A$,LB -1))
  464. 5750  RETURN 
  465. 5800 YN$ = "": IF RC$(LA) = ""  THEN 5850
  466. 5810 LB = 0: FOR I =  LEN(RC$(LA)) TO 1  STEP  -1: IF  MID$ (RC$(LA),I,1) = Q$(4)  THEN LB = I:I = 1
  467. 5820  NEXT : IF LB = 0  THEN 5850
  468. 5830 YN$ =  RIGHT$(RC$(LA), LEN(RC$(LA)) -LB +1)
  469. 5850 LC = MG: IF LA = 9  THEN LC = CN
  470. 5860 RC$(LA) =  STR$(LC) +YN$: RETURN 
  471. 5900 K = IX:X8 = X5: IF  LEN(A$) < = Q(22) -K  THEN  PRINT A$;:IX = IX + LEN(A$): RETURN 
  472. 5910 LC = 0:BB$ = "": FOR I = Q(22) -K TO 1  STEP  -1: IF  MID$ (A$,I,1) = " "  THEN LC = I:I = 1
  473. 5915  IF  MID$ (A$,I,1) = ";"  THEN LC = I:I = 1:BB$ = ";"
  474. 5917  IF  MID$ (A$,I,1) = Q$(4)  THEN LC = I:I = 1:BB$ = Q$(4)
  475. 5920  NEXT : IF LC <2  THEN  PRINT : GOSUB 3800: PRINT  SPC( (X8 <X5) *K)A$;:IX = (X8 <X5) *K + LEN(A$): RETURN 
  476. 5930  PRINT  SPC( (X8 <X5) *K) LEFT$(A$,LC -1)BB$: GOSUB 3800: IF  LEN(A$) -LC < = Q(22) -K  THEN  PRINT  SPC( K) RIGHT$(A$, LEN(A$) -LC);:IX =  LEN(A$) -LC +K: RETURN 
  477. 5940 A$ =  RIGHT$(A$, LEN(A$) -LC): GOTO 5910
  478. 6000 A = 0: IF A$ = ""  OR D$ = ""  THEN  RETURN 
  479. 6010  FOR I = 1 TO  LEN(D$): FOR J = 1 TO  LEN(A$): IF  MID$ (A$,J,1) =  MID$ (D$,I,1)  THEN A = A +1:J =  LEN(A$)
  480. 6020  NEXT : NEXT :A = A/ LEN(D$): RETURN 
  481. 6760  GOSUB 850: PRINT : PRINT "A) RUN ANOTHER PROGRAM": PRINT "B) CHECK FREE SPACE": PRINT "C) RETURN TO 'EDIT'": PRINT "D) END SESSION": PRINT : INVERSE : PRINT "CHOICE (A-D)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN 6780
  482. 6766 C1 =  ASC(YN$) -64: IF C1 <1  OR C1 >4  THEN 6760
  483. 6768  ON C1 GOTO 6780,6770,20000,6820
  484. 6770  PRINT "FREE SPACE="; FRE(0): GOSUB 690: GOTO 6760
  485. 6780 A$ = "": GOSUB 6840: IF CZ  THEN 6760
  486. 6785  GOSUB 7100: PRINT "LOADING NEXT MODULE": GOSUB 6800: ONERR  GOTO 6799
  487. 6788  PRINT  CHR$(4)"PREFIX,S"WH(BB,2)",D"WH(BB,3): PRINT  CHR$(4)"PREFIX": INPUT PF$:A$ = ME$(WH(BB,1)): IF  LEFT$(A$, LEN(PF$)) = PF$  THEN PF$ = A$: PRINT  CHR$(4)"PREFIX"PF$
  488. 6790  PRINT  CHR$(4)"RUNPROGRAMS"
  489. 6799 WH(BB,0) =  -1: GOTO 6780
  490. 6800  ONERR  GOTO 6850
  491. 6805  IF OP(9)  AND C4  THEN  GOSUB 2896: PRINT  CHR$(4)"OPEN"PF$"LASTID,S"WH(BB,2)",D"WH(BB,3): PRINT  CHR$(4)"WRITE"PF$"LASTID": PRINT OP(7): PRINT  CHR$(4)"CLOSE"
  492. 6810  RETURN 
  493. 6820  IF   NOT OP(9)  OR   NOT C4  THEN 6830
  494. 6825  POKE 216,0:A$ = " WITH EDIT": GOSUB 6840: GOSUB 6800
  495. 6830  GOSUB 850: PRINT Q$(21): PRINT "BYE...": END 
  496. 6840 CZ = 0:BB =  -1: IF WH(LD,0) =  -3  THEN BB = LD: RETURN 
  497. 6842  FOR I = 1 TO MP: IF WH(I,0) =  -3  THEN BB = I:LD = I:I = MP
  498. 6845  NEXT : IF BB >0  THEN  RETURN 
  499. 6846 BB = Q(29): PRINT : PRINT "CAN'T FIND PROGRAM DISK";: GOSUB 690:CZ = 1: RETURN 
  500. 6850 A =  PEEK(222): IF A = 9  THEN  PRINT "DISK FULL -- CAN'T SAVE LAST ID";: GOSUB 690: GOTO 6760
  501. 6853  IF A < >4  THEN 16550
  502. 6855  PRINT "PLEASE REMOVE THE WRITE-PROTECT TAB";: GOSUB 860: PRINT "FROM THE PROGRAM DISK": PRINT : GOSUB 600
  503. 6860  PRINT  CHR$(4)"OPEN LASTID": PRINT  CHR$(4)"WRITE LASTID": RESUME 
  504. 6880 X2 = 0:X9 = 0
  505. 6885 X2 = X2 +1: IF X2 >OB  THEN  RETURN 
  506. 6890 X = T(X2): IF X = 0  THEN 6885
  507. 6900  GOSUB 7620:W = Y: GOSUB 420
  508. 6910  GOSUB 5200: IF FL  THEN  GOSUB 8100
  509. 7020  GOTO 6885
  510. 7100  POKE 34,0: GOSUB 850: FOR I = 1 TO 7: PRINT : NEXT : INVERSE : PRINT "PLEASE WAIT";: NORMAL : PRINT "...": PRINT : PRINT  TAB( 14);: RETURN 
  511. 7220 X2 = 0
  512. 7230 X2 = X2 +1: IF X2 >Q(19)  THEN  RETURN 
  513. 7240 X =  VAL(S$(1,X2)): IF X = 0  THEN 7230
  514. 7260  GOSUB 7620: IF MG < VAL(S$(0,X2))  THEN MG =  VAL(S$(0,X2)):IX = MG:LA = 8: GOSUB 5800: GOTO 7320
  515. 7280 IX = 0: FOR X3 = 1 TO MG: IF Y =  VAL(MI$(1,X3))  THEN IX = X3:X3 = MG
  516. 7300  NEXT : IF IX = 0  THEN IX =  VAL(S$(0,X2)): IF IX = 0  THEN 7230
  517. 7320 MI$(1,IX) =  STR$(Y): FOR X3 = 2 TO 3: IF S$(X3,X2) < >""  THEN  IF MI$(X3,IX) = ""  OR (MI$(X3,IX) < >""  AND OP(3))  THEN MI$(X3,IX) = S$(X3,X2)
  518. 7340  NEXT :A$ =  LEFT$(MI$(4,IX),1):B$ = S$(4,X2): IF  LEN(B$) >1  AND A$ = ""  THEN MI$(4,IX) = "?": GOTO 7390
  519. 7350  IF  LEN(B$) >1  OR ( LEN(B$) = 0  AND A$ < >"")  THEN 7390
  520. 7360  IF B$ = ""  AND A$ = ""  THEN MI$(4,IX) = "M"
  521. 7370  IF B$ = "M"  OR B$ = "E"  OR B$ = "D"  THEN  IF A$ = ""  OR (A$ < >""  AND OP(3))  THEN MI$(4,IX) = B$
  522. 7380  IF B$ = "W"  THEN  IF A$ = ""  OR (A$ < >""  AND OP(3))  THEN MI$(4,IX) = "M"
  523. 7390  GOSUB 8100: GOTO 7230
  524. 7400 X2 = 0:X3 = 0: IF G(9)  THEN X = Y: GOSUB 7620: IF RC$(G(9)) < >""  THEN X3 = ( LEFT$(RC$(G(9)),1) = "M"): GOTO 7430
  525. 7410 W = Y: GOSUB 420
  526. 7420  IF N3$ = ""  THEN  GOSUB 850: PRINT : PRINT "IS "N1$" "N2$" "N4$" MALE?";: GOSUB 690:X3 =   NOT (YN$ = "N")
  527. 7430 X2 = X2 +1: IF X2 >OD  THEN  RETURN 
  528. 7440 X = OD(X2): IF X = 0  THEN 7430
  529. 7450  GOSUB 7620
  530. 7460 X6 = 6:X7 = 7: IF X3  THEN X6 = 7:X7 = 6
  531. 7470  IF RC$(X6) = ""  OR (RC$(X6) < >""  AND OP(3))  THEN RC$(X6) =  STR$(Y)
  532. 7480  IF OP(4)  THEN  IF OE(X2) >0  THEN  IF RC$(X7) = ""  OR (RC$(X7) < >""  AND OP(3))  THEN RC$(X7) =  STR$(OE(X2))
  533. 7490  GOSUB 8100: GOTO 7430
  534. 7620 W = X: GOSUB 2500: IF FF < >BB  THEN  GOSUB 8660
  535. 7625  FOR I = 1 TO Q(19): FOR J = 1 TO 4:MI$(J,I) = "": NEXT : NEXT : FOR I = 1 TO Q(18):C$(I) = "": NEXT 
  536. 7630  FOR I = 1 TO Q(17):EX$(I) = "": NEXT : ONERR  GOTO 8000
  537. 7635  IF FF = 0  THEN  GOSUB 2896:ZF$ = PF$ +"FAMILY." + STR$(WH(BB,4)): PRINT  CHR$(4)"OPEN"ZF$",L"Q(16)",S"WH(BB,2)",D"WH(BB,3):FF = BB
  538. 7640  PRINT  CHR$(4)"READ"ZF$",R"X -WH(BB,0)
  539. 7660 II = 1: CALL LI:RC$(1) =  MID$ (T$,1): IF RC$(1) < >""  THEN  IF  ASC(RC$(1)) = 34  THEN II = 2:RC$(1) =  MID$ (RC$(1),2)
  540. 7680  FOR I = 2 TO 10: CALL LI:RC$(I) =  MID$ (T$,II): NEXT 
  541. 7700 A$ = RC$(8): GOSUB 5700:MG = A: IF MG >0  THEN  FOR I = 1 TO MG: FOR J = 1 TO 4: CALL LI:MI$(J,I) =  MID$ (T$,II): NEXT : NEXT 
  542. 7740 A$ = RC$(9): GOSUB 5700:CN = A: IF CN >0  THEN  FOR I = 1 TO CN: CALL LI:C$(I) =  MID$ (T$,II): NEXT 
  543. 7770 A$ = RC$(10): GOSUB 5700:NT = A: IF NT >0  THEN  FOR I = 1 TO NT: CALL LI:EX$(I) =  MID$ (T$,II): NEXT 
  544. 7775  FOR I = 11 TO 20: CALL LI:RC$(I) =  MID$ (T$,II): NEXT 
  545. 7780  PRINT  CHR$(4): POKE 216,0: RETURN 
  546. 7840 Z = 0:A =  LEN(AA$) - LEN(BB$): IF A <0  THEN  RETURN 
  547. 7880 I = A +1
  548. 7900  IF BB$ =  MID$ (AA$,I, LEN(BB$))  THEN Z = I
  549. 7920 I = I -1: IF I >0  THEN 7900
  550. 7940  RETURN 
  551. 8000 A =  PEEK(222): POKE 216,0: IF A < >254  AND A < >5  THEN 16550
  552. 8005  PRINT "ERROR WHILE READING RECORD "X;: GOSUB 690: IF YN$ = CZ$  THEN 20000
  553. 8010  ONERR  GOTO 8000
  554. 8020  RESUME 
  555. 8100  IF Q(26)  THEN RC$(11) = DZ$
  556. 8110  GOSUB 7100: PRINT "SAVING RECORD FOR "RN$"="X: GOSUB 8440: IF   NOT JR  THEN 8180
  557. 8120 W = X: GOSUB 420: GOSUB 850: PRINT "THE RECORD FOR "N1$" "N2$" "N3$" "N4$: PRINT "WOULD BE "A -Q(16)" CHARACTERS LONGER THAN THE";: GOSUB 860: PRINT "MAX RECORD LENGTH AND WON'T BE CHANGED"
  558. 8140  IF Y = X  THEN  PRINT "REENTER DATA?";: GOSUB 690: IF YN$ = "N"  THEN JR = 0
  559. 8160  RETURN 
  560. 8180 W = X: GOSUB 2500: IF FF < >BB  THEN  GOSUB 8660
  561. 8200  ONERR  GOTO 16720
  562. 8220  IF FF = 0  THEN  GOSUB 2896:ZF$ = PF$ +"FAMILY." + STR$(WH(BB,4)): PRINT  CHR$(4)"OPEN"ZF$",L"Q(16)",S"WH(BB,2)",D"WH(BB,3):FF = BB
  563. 8230  PRINT  CHR$(4)"WRITE"ZF$",R"X -WH(BB,0)
  564. 8240  FOR I = 1 TO 10: PRINT RC$(I): NEXT 
  565. 8260  IF MG >0  THEN  FOR I = 1 TO MG: FOR J = 1 TO 4: PRINT MI$(J,I): NEXT : NEXT 
  566. 8300  IF CN >0  THEN  FOR I = 1 TO CN: PRINT C$(I): NEXT 
  567. 8330  IF NT >0  THEN  FOR I = 1 TO NT: PRINT EX$(I): NEXT 
  568. 8337  FOR I = 11 TO 20: PRINT RC$(I): NEXT 
  569. 8340  PRINT  CHR$(4): POKE 216,0: RETURN 
  570. 8440 JR = 0:A = 0: FOR I = 1 TO 20:A = A + LEN(RC$(I)): NEXT 
  571. 8460  IF MG >0  THEN  FOR I = 1 TO MG: FOR J = 1 TO 4:A = A + LEN(MI$(J,I)): NEXT : NEXT 
  572. 8500  IF CN >0  THEN  FOR I = 1 TO CN:A = A + LEN(C$(I)): NEXT 
  573. 8530  IF NT >0  THEN  FOR I = 1 TO NT:A = A + LEN(EX$(I)): NEXT 
  574. 8540 A = A +20 +4 *MG +CN +NT
  575. 8550  IF A >Q(16)  THEN JR = 1
  576. 8560  RETURN 
  577. 8600  IF KY <0  THEN  PRINT "NO FUNCTION KEYS ALLOCATED";: FOR I = 1 TO 3000: NEXT : RETURN 
  578. 8605  POKE 34,0: GOSUB 850: PRINT "SET FUNCTION KEY BY USING THE KEY:": PRINT 
  579. 8610  FOR I = 0 TO KY: PRINT "CTRL-" CHR$(KY(I) +64)": "KY$(I): NEXT : PRINT 
  580. 8620  INVERSE : PRINT "WHICH?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  581. 8630 J =  -1: FOR I = 0 TO KY: IF  ASC(YN$) = KY(I)  THEN J = I
  582. 8635  NEXT : IF J <0  THEN 8620
  583. 8640  PRINT : PRINT "VALUE FOR CTRL-" CHR$(KY(J) +64);: GOSUB 300: IF A$ = ""  THEN 8600
  584. 8645 KY$(J) = A$: GOTO 8600
  585. 8650 FS = 0: IF ZN$ < >""  THEN  PRINT  CHR$(4)"CLOSE"ZN$
  586. 8655  RETURN 
  587. 8660 FF = 0: IF ZF$ < >""  THEN  PRINT  CHR$(4)"CLOSE"ZF$
  588. 8665  RETURN 
  589. 9000  DATA 5
  590. 9020  DATA EDIT RECORDS,EDIT NAMES,SET FUNCTION KEYS,CHANGE PROGRAM PARAMETERS,EXIT PROGRAM
  591. 9040  DATA  4
  592. 9060  DATA NUMBER RANGE,NUMBER LIST,NAME SET,LIST IN MEMORY
  593. 9080  DATA 4
  594. 9090  DATA LAST NAME AT BIRTH,FIRST NAME(S),MARRIED LAST NAME,"TITLE"
  595. 9100  DATA 10
  596. 9120  DATA BORN ON,BORN AT,DEATH DATE OR 'LIVING',DIED/LIVING AT,,MOTHER,FATHER,NUMBER OF MARRIAGES,NUMBER OF CHILDREN,"NUMBER OF NOTES"
  597. 9200  DATA 4
  598. 9210  DATA SPOUSE #,MARRIED ON,MARRIED AT,"MARITAL STATUS"
  599. 9300  DATA 15,SHOW SIZE AFTER EACH INPUT,DO COMPLEMENTING,UNCONDITIONAL SUBSTITUTION,ENTER SPOUSE'S CHILDREN,COMPLEMENT ADDRESS,ADD NAMES SEQUENTIALLY
  600. 9305  DATA NEXT NAME ,STEP START NUMBER,SAVE LAST ON EXIT,COMPLEMENT CHILD WITH NO ,DON'T REDISPLAY SCREEN,ADD NAMES IN BATCHES,ECHO CURRENT ENTRY,ECHO FUNCTION KEY ENTRIES,ALLOW CTRL'S IN DATA
  601. 9310  DATA 1,1,1,1,1,1,0,0,1,1,1,1,1,1,1
  602. 9400  IF X1  THEN  POP 
  603. 9410  RETURN 
  604. 9420  IF CZ  THEN  POP 
  605. 9430  RETURN 
  606. 9540 D$ = " TO":CH$ = " CHANGE ": GOSUB 850: PRINT  SPC( 2);: INVERSE : PRINT "EDITING NAMES": NORMAL : PRINT :X1 = 0:CZ = 0
  607. 9660  PRINT "A) ADD NAMES": PRINT "B) CHANGE A NAME": PRINT "C) REINITIALIZE A RECORD": PRINT "D) STORE NAMES ON DISK"
  608. 9670  PRINT : INVERSE : PRINT "CHOICE (A-D/P/K)?";: GOSUB 690: IF  ASC(YN$) = 13  THEN  RETURN 
  609. 9672  IF YN$ = "K"  THEN  GOSUB 8600: GOTO 9540
  610. 9675  IF YN$ = "P"  THEN  GOSUB 1600: GOTO 9540
  611. 9676  IF YN$ < >CZ$  THEN 9680
  612. 9677  PRINT "NO NAMES WILL BE SAVED.": PRINT : INVERSE : PRINT "ARE YOU SURE?";: GOSUB 690: IF YN$ = "Y"  THEN CZ = 1: RETURN 
  613. 9678  GOTO 9540
  614. 9680 C =  ASC(YN$) -64: IF C <1  OR C >4  THEN 9670
  615. 9710  ON C GOSUB 9760,10000,10850,9720: GOTO 9540
  616. 9720 I = 0: FOR AA = 0 TO Q(37) -1:I = I +PT(AA): NEXT : IF I = 0  THEN  RETURN 
  617. 9722  IF CZ  THEN CZ = 0: FOR AA = 0 TO Q(37) -1:PT(AA) = 0:CT(AA) = 0: RETURN 
  618. 9725  GOSUB 7100: PRINT "SAVING NAMES": FOR AA = 0 TO Q(37) -1: GOSUB 10470: NEXT : RETURN 
  619. 9760  GOSUB 850: IF OP(6)  THEN 9790
  620. 9765  PRINT : PRINT "FOR WHICH "RN$" DO YOU WANT TO ADD A NAME";: INPUT "? ";YN$:X =  VAL(YN$): IF X = 0  THEN  RETURN 
  621. 9767 U = X: GOSUB 500: IF   NOT U  THEN 9765
  622. 9770 W = X: GOSUB 420: GOSUB 9400: IF N1$ +N2$ +N3$ +N4$ = ""  THEN 9820
  623. 9775  PRINT "THAT IS THE "RN$" FOR": PRINT N1$" "N2$" "N3$" "N4$: PRINT "SELECT 'CHANGE A NAME' ON THE MENU TO": PRINT "CHANGE IT.": IF OP(12)  THEN 9765
  624. 9780  FOR I = 1 TO 5000: NEXT : RETURN 
  625. 9790 X = OP(7):OP(7) = OP(7) +1:C4 = 1: IF OP(7) >30  THEN OP(7) = 30: PRINT "NO MORE "RN$"'S AVAILABLE.  RESET ITEM G";: GOSUB 860: PRINT "ON THE MENU OF PARAMETERS.";: GOSUB 690: RETURN 
  626. 9795 W = X: GOSUB 420: GOSUB 9400: IF N1$ +N2$ +N3$ +N4$ = ""  THEN 9820
  627. 9800  PRINT RN$"="X" WAS ALREADY USED.": IF  PEEK( -16384) <128  THEN 9790
  628. 9805  POKE  -16368,0: RETURN 
  629. 9820  PRINT : PRINT "PRESS 'RETURN' BELOW WHERE YOU DON'T";: GOSUB 860: PRINT "HAVE A NAME OR THERE IS NO NAME": PRINT : PRINT "(ADDING "RN$"="X")"
  630. 9825 CH$ = " ENTER NAME":D$ = "":N1$ = "":N2$ = "":N3$ = "":N4$ = "": GOSUB 10140: IF N1$ +N2$ +N3$ +N4$ = ""  OR CZ = 1  THEN OP(7) = OP(7) -1: RETURN 
  631. 9830  GOSUB 10810:PT(AA) = 1: IF OP(12)  THEN 9760
  632. 9840  RETURN 
  633. 10000  PRINT "PERSON'S "RN$;: INPUT " # ";YN$: IF YN$ = ""  THEN  RETURN 
  634. 10010 X =  VAL(YN$):U = X: GOSUB 500: IF   NOT U  THEN 10000
  635. 10020 W = X: GOSUB 420: GOSUB 9400:X5 = 0:IX = 0: GOSUB 639: PRINT "IS THIS THE CORRECT ONE TO CHANGE? ";: GOSUB 690: IF YN$ < >"Y"  THEN 10000
  636. 10070  GOSUB 850: PRINT "PRESS 'RETURN' BELOW WHERE YOU DON'T";: GOSUB 860: PRINT "WANT ANY CHANGES": PRINT : PRINT "CHANGING ";:IX = 9:X5 = 0: GOSUB 636
  637. 10080 CH$ = " CHANGE ":D$ = " TO": GOSUB 10140: GOSUB 10810:PT(AA) = 1: RETURN 
  638. 10140 B$ =  CHR$(5): PRINT : PRINT CH$(1): PRINT CH$N2$D$;: GOSUB 300: GOSUB 9420: IF A$ < >""  THEN N2$ = A$
  639. 10150  IF A$ = B$  THEN N2$ = ""
  640. 10170  PRINT CH$(2): PRINT CH$N1$D$;: GOSUB 300: GOSUB 9420: IF A$ < >""  THEN N1$ = A$
  641. 10180  IF A$ = B$  THEN N1$ = ""
  642. 10200  PRINT CH$(3): PRINT CH$N3$D$;: GOSUB 300: GOSUB 9420: IF A$ < >""  THEN N3$ = A$
  643. 10210  IF A$ = B$  THEN N3$ = ""
  644. 10230  PRINT CH$(4): PRINT CH$N4$D$;: GOSUB 300: GOSUB 9420: IF A$ < >""  THEN N4$ = A$
  645. 10240  IF A$ = B$  THEN N4$ = ""
  646. 10260  RETURN 
  647. 10470 X1 = 0: IF PT(AA) = 0  THEN  RETURN 
  648. 10472 R =  LEN( STR$(PA(AA))): FOR I = Q(36) *AA +1 TO Q(36) *(AA +1):R = R + LEN(NA$(I)): NEXT :R = R +Q(36) +2:R = R + LEN( STR$(R)):A = Q(36) *Q(14) +Q(38): IF A > = R  THEN 10474
  649. 10473  PRINT "THERE ARE "R -A" CHARACTERS TOO MANY FOR";: GOSUB 860: PRINT "NAMES WITH "RN$"'S FROM "PA(AA) +1" TO "PA(AA) +Q(36)".": PRINT "PLEASE SEE MANUAL.";: GOSUB 690:X1 = 1: GOTO 10490
  650. 10474 X9 = W:W = PA(AA) +1: GOSUB 2500:W = X9: IF FS < >BB  THEN  GOSUB 8650
  651. 10475  ONERR  GOTO 16720
  652. 10476  IF FS = 0  THEN  GOSUB 2896:ZN$ = PF$ +"NAMELIST." + STR$(WH(BB,4)): PRINT  CHR$(4)"OPEN"ZN$",S"WH(BB,2)",D"WH(BB,3)",L"Q(36) *Q(14) +Q(38)
  653. 10477 R =  INT((PA(AA) -WH(BB,0))/Q(36)) +1: PRINT  CHR$(4)"WRITE"ZN$",R"R: PRINT PA(AA) -WH(BB,0): PRINT R
  654. 10480  FOR I = Q(36) *AA +1 TO Q(36) *(AA +1): PRINT NA$(I): NEXT : PRINT  CHR$(4):SC(AA) = 0
  655. 10490 PT(AA) = 0: POKE 216,0: RETURN 
  656. 10550 MG = 0:CN = 0:NT = 0: FOR I = 1 TO 20:RC$(I) = "": NEXT : GOSUB 8180
  657. 10560  RETURN 
  658. 10810 BB = X -PA(AA) +Q(36) *AA: IF N3$ = ""  THEN NA$(BB) = N2$ +Q$(5) +N1$ +Q$(5) +N4$: RETURN 
  659. 10815 NA$(BB) = N3$ +Q$(5) +N1$ +Q$(5) +N2$ +Q$(5) +N4$: RETURN 
  660. 10850  PRINT "PERSON'S "RN$;: INPUT " # ";YN$: IF YN$ = ""  THEN  RETURN 
  661. 10860 X =  VAL(YN$):U = X: GOSUB 500: IF   NOT U  THEN 10850
  662. 10870 W = X: GOSUB 420: GOSUB 9400:X5 = 0:IX = 0: GOSUB 639: PRINT "IS THIS THE CORRECT ONE TO REINIT? ";: GOSUB 690: IF YN$ < >"Y"  THEN 10850
  663. 10900  IF  LEFT$(YN$,1) < >"Y"  THEN 10850
  664. 10910  GOSUB 850: PRINT "PRESS 'RETURN' BELOW WHERE YOU DON'T";: GOSUB 860: PRINT "HAVE A NAME OR THERE IS NO NAME.": PRINT : PRINT "(REINITIALIZING "RN$"="W")"
  665. 10930 N1$ = "":N2$ = "":N3$ = "":N4$ = "":CH$ = " ENTER NAME":D$ = "": GOSUB 10140: GOSUB 10550: GOSUB 10810
  666. 10960 PT(AA) = 1: RETURN 
  667. 16000  GOSUB 16500
  668. 16005  PRINT  CHR$(4)"CLOSE": POKE 216,0: GOSUB 850: PRINT  CHR$(4)"PR#"Q(43): GOSUB 7100: PRINT "SETTING UP"
  669. 16010 A$ = DY$: GOSUB 4200:DZ$ = A$: FOR I = 0 TO Q(37) -1:PT(I) = 0: NEXT :C2 = 0:C4 = 0
  670. 16015  READ OB: FOR I = 1 TO OB: READ H$(I): NEXT 
  671. 16020  READ OB: FOR I = 1 TO OB: READ H1$(I): NEXT 
  672. 16025  READ OB: FOR I = 1 TO OB: READ CH$(I): NEXT 
  673. 16030  READ OB: FOR I = 1 TO OB: READ VR$(I): NEXT 
  674. 16035  READ OB: FOR I = 1 TO OB: READ WR$(I): NEXT 
  675. 16040  READ OP: FOR I = 1 TO OP: READ OP$(I): NEXT : FOR I = 1 TO OP: READ TY(I): NEXT :OP$(7) = OP$(7) +RN$:OP$(10) = OP$(10) +RN$:OP$(9) =  LEFT$(OP$(9),10) +RN$ + MID$ (OP$(9),10)
  676. 16090  POKE 34,0: POKE 216,0: GOSUB 9720:FF = 0:FS = 0: PRINT  CHR$(4)"CLOSE": GOSUB 850: HTAB (Q(22) -30)/2: INVERSE : PRINT "EDIT-NAMES-AND-RECORDS PROGRAM": NORMAL : PRINT : PRINT "WHICH DO YOU WANT TO DO:" SPC( 5)DY$
  677. 16100  FOR X = 0 TO Q(37) -1:SC(X) = 0: NEXT : PRINT : FOR X = 1 TO 5: PRINT  CHR$(X +64)") "H$(X): NEXT : PRINT 
  678. 16110  INVERSE : PRINT "CHOICE (A-F)?";: GOSUB 690: IF  ASC(YN$) = 13  THEN 6760
  679. 16120  IF YN$ = "P"  THEN YN$ = "D"
  680. 16130  IF YN$ = "K"  THEN YN$ = "C"
  681. 16140  PRINT :C1 =  ASC(YN$) -64: IF C1 <1  OR C1 >5  THEN 16110
  682. 16150  IF C1 = 5  THEN 6760
  683. 16170  ON C1 GOSUB 16180,9540,8600,1600: GOTO 16090
  684. 16180  PRINT H$(C1)" BY:": PRINT 
  685. 16190 L = 3: IF LO >0  THEN L = 4
  686. 16200  FOR X = 1 TO L: PRINT  CHR$(X +64)") "H1$(X): NEXT : PRINT 
  687. 16210  INVERSE : PRINT "CHOICE (A-" CHR$(L +64)"/P/K/M)?";: GOSUB 690: IF  ASC(YN$) = 13  THEN  RETURN 
  688. 16215  IF YN$ = "M"  THEN  GOSUB 840: GOTO 16180
  689. 16220  IF YN$ = "P"  THEN  GOSUB 1600: GOSUB 850: GOTO 16180
  690. 16230  IF YN$ = "K"  THEN  GOSUB 8600: GOSUB 850: GOTO 16180
  691. 16240 C3 =  ASC(YN$) -64: IF C3 <1  OR C3 >L  THEN 16210
  692. 16250  PRINT : ON C3 GOSUB 1000,740,1260,770: RETURN 
  693. 16500  ONERR  GOTO 16540
  694. 16510  PRINT  CHR$(4)"OPENCONFIGURATION": PRINT  CHR$(4)"READCONFIGURATION": FOR I = 1 TO 84: INPUT A: NEXT 
  695. 16520  FOR I = 1 TO 50: CALL LI: NEXT 
  696. 16530  FOR I = 1 TO 14: INPUT OP(I): NEXT : FOR I = 1 TO 112: INPUT OP(15): NEXT : PRINT  CHR$(4)"CLOSE": POKE 216,0: GOSUB 16560: RETURN 
  697. 16540 A =  PEEK(222): IF A = 5  OR A = 6  OR A = 8  THEN  PRINT "NO CONFIGURATION FILE AVAILABLE ON DISK";: GOSUB 860: PRINT "LAST USED. PLEASE SEE MANUAL.": END 
  698. 16550  PRINT "ERROR # "A" IN LINE " PEEK(218) +256 * PEEK(219)". PLEASE SEE";: GOSUB 860: PRINT "DOS MANUAL.";: GOSUB 690: GOTO 19000
  699. 16560  IF   NOT OP(9)  THEN  RETURN 
  700. 16570  ONERR  GOTO 16005
  701. 16580  PRINT  CHR$(4)"OPEN LASTID": PRINT  CHR$(4)"READ LASTID": INPUT OP(7): PRINT  CHR$(4)"CLOSE"
  702. 16590  POKE 216,0: RETURN 
  703. 16720 A =  PEEK(222): POKE 216,0: GOTO 16550
  704. 19000  ONERR  GOTO 19020
  705. 19010  POP : GOTO 19010
  706. 19020  POKE 216,0: GOTO 16090
  707. 20000  GOTO 19000